home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 1.iso / games / minehl1a.zip / MINEHELP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-29  |  20KB  |  635 lines
  1. PROGRAM MineHelp;
  2.  
  3.   {Version 1.00: April 26, 1992.
  4.    Version 1.01: May 8, 1993.
  5.    Version 1.02: May 29, 1993.
  6.    Peter Karrer (pkarrer@bernina.ethz.ch / 100121,2215)}
  7.  
  8.   {$M 40960,8192}
  9.   {$G+}
  10.  
  11.   USES WObjects, WinTypes, WinProcs, Strings;
  12.  
  13.   {$R MINEHELP.RES}
  14.  
  15.   CONST
  16.     appName = 'MineHelp';
  17.     {Child control IDs}
  18.     inactive = 103;
  19.     active = 104;
  20.     automatic = 105;
  21.     basic = 106;
  22.     expert = 107;
  23.     rand = 108;
  24.     id_Animation = 110;
  25.     id_OK = 109;
  26.  
  27.     white = $ffffff;
  28.     {colors masked with $ffc0c0c0}
  29.     blue  = $c00000;
  30.     dblue = $800000;
  31.     red   = $0000c0;
  32.     dred  = $000080;
  33.     dgreen= $008000;
  34.     dcyan = $808000;
  35.     black = 0;
  36.     dgray = $808080;
  37.     gray  = $c0c0c0;
  38.     xOff = -4; { width of left border in Minesweeper window client area - 16}
  39.     yOff = 39; { width of top  border in Minesweeper window client area - 16}
  40.  
  41.   TYPE
  42.  
  43.     TThisApp = OBJECT(TApplication)
  44.       PROCEDURE InitMainWindow; VIRTUAL;
  45.     END;
  46.  
  47.     PThisWindow = ^TThisWindow;
  48.     TThisWindow = OBJECT(TDlgWindow)
  49.       stat: INTEGER; {id of checked "Status" button}
  50.       lev: INTEGER;  {id of checked "Level" button}
  51.       animation: BOOLEAN;
  52.       msWin: HWnd;
  53.       mswX, mswY: INTEGER;
  54.       dimX, dimY: INTEGER;
  55.       busy: BOOLEAN;
  56.       CONSTRUCTOR Init;
  57.       FUNCTION  GetClassName: PCHAR; VIRTUAL;
  58.       PROCEDURE GetWindowClass(VAR c: TWndClass); VIRTUAL;
  59.       PROCEDURE SetupWindow; VIRTUAL;
  60.       PROCEDURE DefChildProc(VAR msg: TMessage); VIRTUAL;
  61.       PROCEDURE WMDestroy(VAR msg: TMessage); VIRTUAL wm_first + wm_Destroy;
  62.       PROCEDURE WMTimer(VAR msg: TMessage); VIRTUAL wm_first + wm_Timer;
  63.       PROCEDURE DoIt;
  64.       FUNCTION  GetMsWin: HWnd;
  65.       PROCEDURE GetBoard(VAR bomb: BOOLEAN);
  66.       PROCEDURE Click(x, y: INTEGER; btnDown, btnUp, modifier: WORD);
  67.       PROCEDURE Mark(x, y: INTEGER);
  68.       PROCEDURE ClearFields(VAR somethingDone: BOOLEAN);
  69.       PROCEDURE MarkFields(VAR somethingDone: BOOLEAN);
  70.       FUNCTION  TwoFieldSearch(x1, y1, x2, y2: INTEGER): BOOLEAN;
  71.       PROCEDURE TwoFields(VAR success: BOOLEAN);
  72.       PROCEDURE ClearRandom(VAR somethingHappened: BOOLEAN);
  73.     END;
  74.  
  75.   VAR
  76.     thisApp: TThisApp;
  77.     bb: ARRAY [0..25, 0..31] OF INTEGER;
  78.     ee: ARRAY [0..25, 0..31] OF INTEGER;
  79.  
  80.   CONSTRUCTOR TThisWindow.Init;
  81.   BEGIN
  82.     TDlgWindow.Init(NIL, appName);
  83.   END;
  84.  
  85.   FUNCTION TThisWindow.GetClassName: PCHAR;
  86.   BEGIN
  87.     GetClassName := appName;
  88.   END;
  89.  
  90.   PROCEDURE TThisWindow.GetWindowClass(VAR c: TWndClass);
  91.   BEGIN
  92.     TDlgWindow.GetWindowClass(c);
  93.     {c.hIcon := LoadIcon(hInstance, appName); doesn't work?!}
  94.   END;
  95.  
  96.   PROCEDURE TThisWindow.SetupWindow;
  97.     VAR
  98.       i: INTEGER;
  99.   BEGIN
  100.     TDlgWindow.SetupWindow;
  101.     IF SetTimer(hWindow, 1, 1000, NIL) = 0 THEN BEGIN
  102.       MessageBox(HWindow, 'Sorry, no timers', NIL, mb_Ok);
  103.       Destroy;
  104.     END;
  105.     {Setting the icon didn't work in GetWindowClass, dunno why}
  106.     SetClassWord(hWindow, GCW_HICON, LoadIcon(hInstance, appName));
  107.     animation := POS('n', ParamStr(1)) <> 0;
  108.     IF POS('h', ParamStr(1)) <> 0 THEN BEGIN
  109.       cmdShow := sw_Hide;
  110.     END ELSE IF POS('c', ParamStr(1)) <> 0 THEN BEGIN
  111.       cmdShow := sw_Minimize;
  112.     END;
  113.     IF POS('a', ParamStr(1)) <> 0 THEN BEGIN
  114.       stat := active;
  115.     END ELSE IF POS('i', ParamStr(1)) <> 0 THEN BEGIN
  116.       stat := inactive;
  117.     END ELSE BEGIN
  118.       stat := automatic;
  119.     END;
  120.     IF POS('b', ParamStr(1)) <> 0 THEN BEGIN
  121.       lev := basic;
  122.     END ELSE IF POS('r', ParamStr(1)) <> 0 THEN BEGIN
  123.       lev := rand;
  124.     END ELSE BEGIN
  125.       lev := expert;
  126.     END;
  127.     SendDlgItemMsg(stat, bm_SetCheck, 1, 0);
  128.     SendDlgItemMsg(lev, bm_SetCheck, 1, 0);
  129.     SendDlgItemMsg(id_animation, bm_SetCheck, ORD(animation), 0);
  130.     RANDOMIZE;
  131.     busy := FALSE;
  132.   END;
  133.  
  134.   PROCEDURE WaitIdle;
  135.     {It's impolite to hog the CPU}
  136.     VAR
  137.       m: TMsg;
  138.   BEGIN
  139.     WHILE PeekMessage(m, 0, 0, 0, pm_Remove) DO BEGIN
  140.       IF m.message = wm_Quit THEN BEGIN
  141.         HALT(m.wParam);
  142.       END;
  143.       TranslateMessage(m);
  144.       DispatchMessage(m);
  145.     END;
  146.   END;
  147.  
  148.   PROCEDURE TThisWindow.Click(x, y: INTEGER; btnDown, btnUp, modifier: WORD);
  149.   BEGIN
  150.     IF animation THEN BEGIN
  151.       SetCursorPos(mswX + xOff + 16*x + 8, mswY + yOff + 16*y + 8);
  152.     END;
  153.     SendMessage(msWin, btnDown, modifier, MakeLong(xOff + 16*x, yOff + 16*y));
  154.     SendMessage(msWin, btnUp, modifier, MakeLong(xOff + 16*x, yOff + 16*y));
  155.   END; {Click}
  156.  
  157.   PROCEDURE TThisWindow.GetBoard(VAR bomb: BOOLEAN);
  158.     {Examine the Minesweeper window client area. Get the contents of the
  159.      individual squares by reading pixels at strategic locations. Colors
  160.      are masked with $FFC0C0C0, because not all display drivers use the same
  161.      intensities for colors like dark cyan or dark red}
  162.     VAR
  163.       x, y, v: INTEGER;
  164.       rgb: LONGINT;
  165.       msDC: HDC;
  166.   BEGIN
  167.     bomb := FALSE;
  168.     msDC := GetDC(msWin);
  169.     FOR y := 1 TO dimY DO BEGIN
  170.       FOR x := 1 TO dimX DO BEGIN
  171.         rgb := GetPixel(msDC, xOff + 9 + 16*x, yOff + 12 + 16*y) AND $ffc0c0c0;
  172.         IF rgb = blue THEN BEGIN
  173.           bb[y, x] := 1;
  174.         END ELSE IF rgb = dgreen THEN BEGIN
  175.           bb[y, x] := 2;
  176.         END ELSE IF rgb = red THEN BEGIN
  177.           bb[y, x] := 3;
  178.         END ELSE IF rgb = dblue THEN BEGIN
  179.           bb[y, x] := 4;
  180.         END ELSE IF rgb = dred THEN BEGIN
  181.           bb[y, x] := 5;
  182.         END ELSE IF rgb = dcyan THEN BEGIN
  183.           bb[y, x] := 6;
  184.         END ELSE IF rgb = black THEN BEGIN
  185.           rgb := GetPixel(msDC, xOff + 7 + 16*x, yOff + 6 + 16*y);
  186.           IF rgb = white THEN BEGIN
  187.             bb[y, x] := -2; bomb := TRUE; {mine}
  188.           END ELSE BEGIN
  189.             rgb := rgb AND $ffc0c0c0;
  190.             IF rgb = gray THEN BEGIN
  191.               bb[y, x] := 7;
  192.             END ELSE IF rgb = red THEN BEGIN
  193.               bb[y, x] := 128; {flag}
  194.             END ELSE IF rgb = black THEN BEGIN
  195.               bb[y, x] := 2049; {question mark}
  196.             END ELSE BEGIN
  197.               bb[y, x] := -999; bomb := TRUE; {invisible}
  198.             END;
  199.           END;
  200.         END ELSE IF rgb = dgray THEN BEGIN
  201.           bb[y, x] := 8;
  202.         END ELSE IF rgb = gray THEN BEGIN
  203.           rgb := GetPixel(msDC, xOff + 15 + 16*x, yOff + 1 +16*y) AND $ffc0c0c0;
  204.           IF rgb = gray THEN BEGIN
  205.             bb[y, x] := 0;
  206.           END ELSE IF rgb = dgray THEN BEGIN
  207.             rgb := GetPixel(msDC, xOff + 5 + 16*x, yOff + 5 +16*y) AND $ffc0c0c0;
  208.             IF rgb = black THEN BEGIN
  209.               bb[y,x] := 2049; {question mark}
  210.             END ELSE IF rgb = gray THEN BEGIN
  211.               bb[y, x] := 2048; {covered}
  212.             END ELSE BEGIN
  213.               bb[y, x] := -999; bomb := TRUE;
  214.             END;
  215.           END ELSE BEGIN
  216.             bb[y, x] := -999; bomb := TRUE; {invisible}
  217.           END;
  218.         END ELSE BEGIN
  219.           bb[y, x] := -999; bomb := TRUE; {invisible}
  220.         END;
  221.       END; {FOR x}
  222.     END; {FOR y}
  223.     ReleaseDC(msWin, msDC);
  224.     IF NOT bomb THEN BEGIN
  225.       FOR y := 1 TO dimY DO BEGIN
  226.         FOR x := 1 TO dimX DO BEGIN
  227.           v := bb[y, x];
  228.           IF (v > 0) AND (v <= 8) THEN BEGIN
  229.             ee[y, x] := bb[y-1,x-1]+bb[y-1,x]+bb[y-1,x+1]+bb[y,x-1]+
  230.                         bb[y,x+1]+bb[y+1,x-1]+bb[y+1,x]+bb[y+1,x+1];
  231.           END ELSE BEGIN
  232.             ee[y, x] := 0;
  233.           END;
  234.         END; {FOR x}
  235.       END; {FOR y}
  236.     END; {NOT bomb}
  237.   END; {GetBoard}
  238.  
  239.   FUNCTION TThisWindow.GetMsWin: HWnd;
  240.     {Find the Minesweeper window and its location on the screen}
  241.     VAR
  242.       w, mW: HWnd;
  243.       st: ARRAY[0..32] OF CHAR;
  244.       rp: RECORD
  245.             CASE INTEGER OF 1: (r: TRect);
  246.                             2: (p: TPoint);
  247.           END;
  248.       i: INTEGER;
  249.   BEGIN
  250.     w := 0;
  251.     mW := 0;
  252.     w := GetWindow(hWindow, gw_HWndFirst);
  253.     WHILE (w <> 0) AND (mW = 0) DO BEGIN
  254.       WinProcs.GetClassName(w, st, 32); {v1.02}
  255.       IF StrComp(st, 'Minesweeper') = 0 THEN BEGIN
  256.         mW := w;
  257.         GetClientRect(mW, rp.r);
  258.         dimX := (rp.r.right - 24) DIV 16;
  259.         dimY := (rp.r.bottom - 67) DIV 16;
  260.         ClientToScreen(mW, rp.p);
  261.         mswX := rp.p.x;
  262.         mswY := rp.p.y;
  263.       END;
  264.       w := GetNextWindow(w, gw_HWndNext);
  265.     END;
  266.     IF mW <> 0 THEN BEGIN
  267.       FOR i := 0 TO dimX + 1 DO BEGIN
  268.         bb[0, i] := 0;
  269.         ee[0, i] := 0;
  270.         bb[dimY + 1, i] := 0;
  271.         ee[dimY + 1, i] := 0;
  272.       END;
  273.       FOR i:= 1 TO dimY DO BEGIN
  274.         bb[i, 0] := 0;
  275.         ee[i, 0] := 0;
  276.         bb[i, dimX + 1] := 0;
  277.         ee[i, dimX + 1] := 0;
  278.       END;
  279.     END;
  280.     GetMsWin := mW;
  281.   END; {GetMsWin}
  282.  
  283.   PROCEDURE TThisWindow.ClearFields(VAR somethingDone: BOOLEAN);
  284.     VAR
  285.       x, y, v, c: INTEGER;
  286.   BEGIN
  287.     somethingDone := FALSE;
  288.     FOR y := 1 TO dimY DO BEGIN
  289.       FOR x := 1 TO dimX DO BEGIN
  290.         v := bb[y, x];
  291.         IF (v > 0) AND (v <= 8) THEN BEGIN
  292.           c := ee[y, x];
  293.           IF c >= 2048 THEN BEGIN {at least 1 covered field}
  294.             c := c AND 2047 SHR 7; {number of flagged fields}
  295.             IF v = c THEN BEGIN
  296.               Click(x, y, wm_LButtonDown, wm_LButtonUp, mk_RButton);
  297.               somethingDone := TRUE;
  298.               IF stat <> automatic THEN BEGIN
  299.                 EXIT;
  300.               END;
  301.             END;
  302.           END;
  303.         END; {IF (v > 0) ..}
  304.       END; {FOR x}
  305.     END; {FOR y}
  306.   END; {ClearFields}
  307.  
  308.   PROCEDURE TThisWindow.Mark(x, y: INTEGER);
  309.   BEGIN
  310.     Click(x, y, wm_RButtonDown, wm_RButtonUp, 0);
  311.     IF bb[y, x] = 2049 THEN BEGIN {question mark}
  312.       Click(x, y, wm_RButtonDown, wm_RButtonUp, 0);
  313.     END;
  314.     bb[y, x] := 128; {make it flagged}
  315.   END; {Mark}
  316.  
  317.   PROCEDURE TThisWindow.MarkFields(VAR somethingDone: BOOLEAN);
  318.     VAR
  319.       x, y, v, c, f: INTEGER;
  320.   BEGIN
  321.     somethingDone := FALSE;
  322.     FOR y := 1 TO dimY DO BEGIN
  323.       FOR x := 1 TO dimX DO BEGIN
  324.         v := bb[y, x];
  325.         IF (v > 0) AND (v <= 8) THEN BEGIN
  326.           c := bb[y-1,x-1]+bb[y-1,x]+bb[y-1,x+1]+bb[y,x-1]+
  327.                bb[y,x+1]+bb[y+1,x-1]+bb[y+1,x]+bb[y+1,x+1];
  328.           f := c SHR 11; {number of covered fields}
  329.           IF f <> 0 THEN BEGIN
  330.             c := c AND 2047 SHR 7; {number of flagged fields}
  331.             IF (f + c) = v THEN BEGIN
  332.               IF bb[y-1,x-1] >= 2048 THEN BEGIN Mark(x-1,y-1); END;
  333.               IF bb[y-1,x  ] >= 2048 THEN BEGIN Mark(x,  y-1); END;
  334.               IF bb[y-1,x+1] >= 2048 THEN BEGIN Mark(x+1,y-1); END;
  335.               IF bb[y,  x-1] >= 2048 THEN BEGIN Mark(x-1,y  ); END;
  336.               IF bb[y,  x+1] >= 2048 THEN BEGIN Mark(x+1,y  ); END;
  337.               IF bb[y+1,x-1] >= 2048 THEN BEGIN Mark(x-1,y+1); END;
  338.               IF bb[y+1,x  ] >= 2048 THEN BEGIN Mark(x,  y+1); END;
  339.               IF bb[y+1,x+1] >= 2048 THEN BEGIN Mark(x+1,y+1); END;
  340.               somethingDone := TRUE;
  341.               IF stat <> automatic THEN BEGIN
  342.                 EXIT;
  343.               END;
  344.             END;
  345.           END;
  346.         END; {IF (v > 0) ..}
  347.       END; {FOR x}
  348.     END; {FOR y}
  349.   END; {MarkFields}
  350.  
  351.   FUNCTION TThisWindow.TwoFieldSearch(x1, y1, x2, y2: INTEGER): BOOLEAN;
  352.     VAR
  353.       a, b, c, x, y, na, nb: INTEGER;
  354.  
  355.     PROCEDURE ClickFields(xx1, yy1, xx2, yy2: INTEGER; marks: BOOLEAN);
  356.       {Click on covered fields in environment of (x1,y1) but not of (x2,y2)}
  357.       VAR
  358.         xx, yy, dbg: INTEGER;
  359.     BEGIN
  360.       FOR yy := yy1 - 1 TO yy1 + 1 DO BEGIN
  361.         FOR xx := xx1 - 1 TO xx1 + 1 DO BEGIN
  362.           IF ((ABS(yy-yy2) > 1) OR (ABS(xx-xx2) > 1)) AND (bb[yy,xx] >= 2048) THEN BEGIN
  363.             IF marks THEN BEGIN
  364.               Mark(xx, yy);
  365.             END ELSE BEGIN
  366.               Click(xx, yy, wm_LButtonDown, wm_LButtonUp, 0);
  367.               bb[yy, xx] := 0; {meaning uncovered with unknown value}
  368.             END;
  369.           END;
  370.         END; {FOR xx}
  371.       END; {FOR yy}
  372.       TwoFieldSearch := TRUE;
  373.     END; {ClickFields}
  374.  
  375.   BEGIN {TwoFieldSearch}
  376.     TwoFieldSearch := FALSE;
  377.     c := ee[y1, x1];
  378.     x := bb[y1, x1] - c AND 2047 SHR 7; {Number of unknown mines around A=(x1,y1)}
  379.     a := c SHR 11; {Number of covered fields around A=(x1,y1)}
  380.     c := ee[y2, x2];
  381.     y := bb[y2, x2] - c AND 2047 SHR 7; {Number of unknown mines around B=(x2,y2)}
  382.     b := c SHR 11; {Number of covered fields around B=(x2,y2)}
  383.     c := 0;
  384.     IF (ABS(y1+1-y2) <=1) AND (ABS(x1-x2) <= 1) AND (bb[y1+1,x1] >= 2048) THEN c := c + 1;
  385.     IF (ABS(y1+1-y2) <=1) AND (ABS(x1+1-x2)<=1) AND (bb[y1+1,x1+1]>=2048) THEN c := c + 1;
  386.     IF (ABS(y1+1-y2) <=1) AND (ABS(x1-1-x2)<=1) AND (bb[y1+1,x1-1]>=2048) THEN c := c + 1;
  387.     IF (ABS(y1-y2) <= 1) AND (ABS(x1+1-x2)<= 1) AND (bb[y1,x1+1] >= 2048) THEN c := c + 1;
  388.     IF (ABS(y1-y2) <= 1) AND (ABS(x1-1-x2)<= 1) AND (bb[y1,x1-1] >= 2048) THEN c := c + 1;
  389.     IF (ABS(y1-1-y2) <=1) AND (ABS(x1-x2) <= 1) AND (bb[y1-1,x1] >= 2048) THEN c := c + 1;
  390.     IF (ABS(y1-1-y2) <=1) AND (ABS(x1+1-x2)<=1) AND (bb[y1-1,x1+1]>=2048) THEN c := c + 1;
  391.     IF (ABS(y1-1-y2) <=1) AND (ABS(x1-1-x2)<=1) AND (bb[y1-1,x1-1]>=2048) THEN c := c + 1;
  392.     {c = number of covered fields common to the environments of A and B}
  393.     IF c < 2 THEN BEGIN {v1.01}
  394.       EXIT;             {v1.01}
  395.     END;                {v1.01}
  396.     a := a - c;
  397.     b := b - c;
  398.     na := -1;
  399.     nb := -1;
  400.     IF a = 0 THEN BEGIN
  401.       na := 0;
  402.     END ELSE IF x + b = y THEN BEGIN
  403.       na := 0;
  404.     END ELSE IF x - a = y THEN BEGIN
  405.       na := a;
  406.     END ELSE IF b = 0 THEN BEGIN
  407.       na := x - y;
  408.     END;
  409.     IF na >= 0 THEN BEGIN
  410.       nb := y - x + na;
  411.     END ELSE IF b = 0 THEN BEGIN
  412.       nb := 0;
  413.     END ELSE IF y - b = x THEN BEGIN
  414.       nb := b;
  415.     END ELSE IF a = 0 THEN BEGIN
  416.       nb := y - x;
  417.     END;
  418.     IF nb >= 0 THEN BEGIN
  419.       na := x - y + nb;
  420.     END;
  421.     IF a <> 0 THEN BEGIN
  422.       IF na = 0 THEN BEGIN
  423.         {Clear all fields in env A but not env B}
  424.         ClickFields(x1, y1, x2, y2, FALSE);
  425.       END ELSE IF na = a THEN BEGIN
  426.         {Mark all those fields}
  427.         ClickFields(x1, y1, x2, y2, TRUE);
  428.       END;
  429.     END;
  430.     IF b <> 0 THEN BEGIN
  431.       IF (nb = 0) AND (b <> 0) THEN BEGIN
  432.         {Clear all fields in env B but not env A}
  433.         ClickFields(x2, y2, x1, y1, FALSE);
  434.       END ELSE IF nb = b THEN BEGIN
  435.         {Mark all those fields}
  436.         ClickFields(x2, y2, x1, y1, TRUE);
  437.       END;
  438.     END;
  439.   END; {TwoFieldSearch}
  440.  
  441.   PROCEDURE TThisWindow.TwoFields(VAR success: BOOLEAN);
  442.  
  443.     PROCEDURE S(x1, y1: INTEGER);
  444.       VAR
  445.         x, y, miny, maxy: INTEGER;
  446.     BEGIN
  447.       IF success AND (stat <> automatic) THEN BEGIN
  448.         EXIT;
  449.       END;
  450.       IF y1 >= 0 THEN BEGIN
  451.         miny := 1;
  452.         maxy := dimY - y1;
  453.       END ELSE BEGIN
  454.         miny := 1 - y1;
  455.         maxy := dimY;
  456.       END;
  457.       FOR y := miny TO maxy DO BEGIN
  458.         FOR x := 1 TO dimX - x1 DO BEGIN
  459.           IF (ee[y, x] >= 2048) AND (ee[y + y1, x + x1] >= 2048) THEN BEGIN
  460.             success := success OR TwoFieldSearch(x, y, x + x1, y + y1);
  461.             IF success AND (stat <> automatic) THEN BEGIN
  462.               EXIT;
  463.             END;
  464.           END;
  465.         END;
  466.       END;
  467.     END; {S}
  468.  
  469.   BEGIN {TwoFields}
  470.     success := FALSE;
  471.     S(1, 0); S(0, -1); S(1, 1); S(1, -1); S(2, -1); S(2, 1);
  472.     S(1, -2); S(1, 2); S(2, 0); S(0, -2); {S(2, -2); S(2, 2); v1.01}
  473.   END; {TwoFields}
  474.  
  475.   PROCEDURE TThisWindow.ClearRandom(VAR somethingHappened: BOOLEAN);
  476.     VAR
  477.       x, y, c, i: INTEGER;
  478.       bomb: BOOLEAN;
  479.   BEGIN
  480.     GetBoard(bomb);
  481.     somethingHappened := FALSE;
  482.     IF NOT bomb THEN BEGIN
  483.       c := 0;
  484.       FOR y := 1 TO dimY DO BEGIN
  485.         FOR x:= 1 TO dimX DO BEGIN
  486.           IF bb[y, x] >= 2048 THEN BEGIN
  487.             c := c + 1;
  488.           END;
  489.         END;
  490.       END;
  491.       IF c <> 0 THEN BEGIN
  492.         i := RANDOM(c);
  493.         c := 0;
  494.         FOR y := 1 TO dimY DO BEGIN
  495.           FOR x := 1 TO dimX DO BEGIN
  496.             IF bb[y, x] >= 2048 THEN BEGIN
  497.               IF c = i THEN BEGIN
  498.                 Click(x, y, wm_LButtonDown, wm_LButtonUp, 0);
  499.                 somethingHappened := TRUE;
  500.                 EXIT;
  501.               END;
  502.               c := c + 1;
  503.             END;
  504.           END; {FOR x}
  505.         END; {FOR y}
  506.       END; {c <> 0}
  507.     END; {NOT bomb}
  508.   END; {ClearRandom}
  509.  
  510.   PROCEDURE TThisWindow.DefChildProc(VAR msg: TMessage);
  511.     VAR
  512.       i: INTEGER;
  513.   BEGIN
  514.     WITH msg DO BEGIN
  515.       IF (lParamLo <> 0) AND (lParamHi <> 1) THEN BEGIN
  516.         { not menu, not accelerator id }
  517.         IF wParam = inactive THEN BEGIN
  518.           stat := inactive;
  519.         END ELSE IF wParam = active THEN BEGIN
  520.           stat := active;
  521.         END ELSE IF wParam = automatic THEN BEGIN
  522.           stat := automatic;
  523.         END ELSE IF wParam = basic THEN BEGIN
  524.           lev := basic;
  525.         END ELSE IF wParam = expert THEN BEGIN
  526.           lev := expert;
  527.         END ELSE IF wParam = rand THEN BEGIN
  528.           lev := rand;
  529.         END ELSE IF wParam = id_Animation THEN BEGIN
  530.           animation := NOT animation;
  531.           SendDlgItemMsg(id_Animation, bm_SetCheck, ORD(animation), 0);
  532.         END ELSE IF wParam = id_OK THEN BEGIN
  533.           IF stat = active THEN BEGIN
  534.             DoIt;
  535.           END;
  536.         END;
  537.       END; {IF (lParamLo ..}
  538.     END; {WITH msg}
  539.     TDlgWindow.DefChildProc(msg);
  540.   END;
  541.  
  542.   PROCEDURE TThisWindow.DoIt;
  543.     VAR
  544.       bomb, somethingHappened, action: BOOLEAN;
  545.       x, y: INTEGER;
  546.       m: TMsg;
  547.   BEGIN
  548.     IF busy THEN BEGIN
  549.       {avoid reentrancy}
  550.       EXIT;
  551.     END;
  552.     busy := TRUE;
  553.     msWin := GetMsWin;
  554.     IF msWin <> 0 THEN BEGIN
  555.      REPEAT
  556.       REPEAT
  557.         GetBoard(bomb);
  558.         action := FALSE;
  559.         somethingHappened := TRUE;
  560.         WHILE NOT bomb AND somethingHappened DO BEGIN
  561.           MarkFields(somethingHappened);
  562.           IF somethingHappened AND (stat <> automatic) THEN BEGIN
  563.             busy := FALSE;
  564.             EXIT;
  565.           END;
  566.           WaitIdle;
  567.           action := action OR somethingHappened;
  568.           {GetBoard(msWin, bomb);}
  569.         END;
  570.         somethingHappened := TRUE;
  571.         WHILE NOT bomb AND somethingHappened DO BEGIN
  572.           ClearFields(somethingHappened);
  573.           IF somethingHappened AND (stat <> automatic) THEN BEGIN
  574.             busy := FALSE;
  575.             EXIT;
  576.           END;
  577.           WaitIdle;
  578.           action := action OR somethingHappened;
  579.           GetBoard(bomb);
  580.         END;
  581.         {action = there were changes in mark and clear phases}
  582.       UNTIL NOT action OR bomb;
  583.       somethingHappened := lev > basic;
  584.       WHILE NOT bomb AND somethingHappened DO BEGIN
  585.         TwoFields(somethingHappened);
  586.         IF somethingHappened AND (stat <> automatic) THEN BEGIN
  587.           busy := FALSE;
  588.           EXIT;
  589.         END;
  590.         WaitIdle;
  591.         action := action OR somethingHappened;
  592.         GetBoard(bomb);
  593.       END;
  594.       IF (lev = rand) AND NOT action THEN BEGIN
  595.         ClearRandom(action);
  596.         IF stat <> automatic THEN BEGIN
  597.           busy := FALSE;
  598.           EXIT;
  599.         END;
  600.       END;
  601.      UNTIL NOT action OR bomb;
  602.     END; {msWin <> 0}
  603.     busy := FALSE;
  604.   END; {DoIt}
  605.  
  606.   PROCEDURE TThisWindow.WMTimer(VAR msg: TMessage);
  607.   BEGIN
  608.     IF stat = automatic THEN BEGIN
  609.       DoIt;
  610.     END;
  611.   END;
  612.  
  613.   PROCEDURE TThisWindow.WMDestroy(VAR msg: TMessage);
  614.   BEGIN
  615.     KillTimer(hWindow, 1);
  616.     TDlgWindow.WMDestroy(msg);
  617.   END;
  618.  
  619.   PROCEDURE TThisApp.InitMainWindow;
  620.   begin
  621.     mainWindow := NEW(PThisWindow, Init);
  622.   end;
  623.  
  624. BEGIN
  625.   {$G-}
  626.   IF (GetWinFlags AND (wf_CPU086 OR wf_CPU186)) <> 0 THEN BEGIN
  627.     MessageBox(0, 'WinHelp needs a 286 or better', NIL, mb_OK);
  628.     HALT(0);
  629.   END;
  630.   {$G+}
  631.   thisApp.Init(appName);
  632.   thisApp.Run;
  633.   thisApp.Done;
  634. END.
  635.